home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / packages / reportmail.el < prev    next >
Encoding:
Text File  |  1995-02-25  |  32.6 KB  |  892 lines

  1. ;; REPORTMAIL: Display time and load in mode line of Emacs.
  2. ;; Originally time.el in the emacs distribution.
  3. ;; Mods by BCP, DCP, and JWZ to display incoming mail.
  4. ;;
  5. ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  11. ;; accepts responsibility to anyone for the consequences of using it
  12. ;; or for whether it serves any particular purpose or works at all,
  13. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  14. ;; License for full details.
  15.  
  16. ;; Everyone is granted permission to copy, modify and redistribute
  17. ;; GNU Emacs, but only under the conditions described in the
  18. ;; GNU Emacs General Public License.   A copy of this license is
  19. ;; supposed to have been given to you along with GNU Emacs so you
  20. ;; can know your rights and responsibilities.  It should be in a
  21. ;; file named COPYING.  Among other things, the copyright notice
  22. ;; and this notice must be preserved on all copies.
  23.  
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25. ;
  26. ; Installation
  27. ; ------------
  28. ;
  29. ; To use reportmail, add the following to your .emacs file:
  30. ;
  31. ;    (load-library "reportmail")
  32. ;
  33. ;    ;; Edit this list as appropriate
  34. ;    (setq display-time-my-addresses
  35. ;     '("Benjamin.Pierce" "bcp" "Benjamin Pierce" "Benjamin C. Pierce"))
  36. ;    ;; By default, mail arrival is reported with a message but no beep
  37. ;    (setq display-time-mail-ring-bell t)
  38. ;    (display-time)
  39. ; When new mail arrives, a brief blurb about it will be displayed in the
  40. ; mode line, and a more verbose message will be printed in the echo area.
  41. ; But unlike most echo-area messages, this message will not go away at
  42. ; the next keystroke - it doesn't go away until the next extended-command
  43. ; is used.  This is cool because that means you won't miss seeing the 
  44. ; subject of the newly-arrived mail because you happened to be typing when
  45. ; it arrived.
  46. ;
  47. ; But if you set the variable `display-time-flush-echo-area' to t, then this
  48. ; message will be cleared every `display-time-interval' seconds.  This means
  49. ; the message will be around for at most 30 seconds or so, which you may
  50. ; prefer.
  51. ;
  52. ; Site Configuration
  53. ; ------------------
  54. ;
  55. ; The variables display-time-incoming-mail-file and 
  56. ; display-time-message-separator identify the location and format of 
  57. ; your waiting messages.  If you are in the CMU SCS environment, or
  58. ; are on a generic BSD unix system, this code should work right away.
  59. ; Otherwise, you might need to modify the values of these to make things
  60. ; work.
  61. ;
  62. ; Junk Mail
  63. ; ---------
  64. ;
  65. ; The reportmail package has a notion of "junk mail," which can be used to
  66. ; reduce the frequency of irritating interruptions by reporting only the
  67. ; arrival of messages that seem to be interesting.  If you're on a lot
  68. ; of high-volume mailing lists, this can be quite convenient.  To use
  69. ; this facility, add something like the following to your .emacs file:
  70. ;   ;; The value of this variable is a list of lists, where the first
  71. ;   ;; element in each list is the name of a header field and the
  72. ;   ;; remaining elements are various elements of the value of this
  73. ;   ;; header field that signal the junkiness of a message.  
  74. ;   (setq display-time-junk-mail-checklist
  75. ;     '(("From" "bcp" "Benjamin Pierce" "Benjamin.Pierce"
  76. ;               "Mail Delivery Subsystem" "network" "daemon@bartok")
  77. ;       ("To" "sml-request" "sml-redistribution-request" 
  78. ;        "scheme" "TeXhax-Distribution-list")
  79. ;       ("Resent-From" "Benjamin.Pierce")
  80. ;       ("Sender" "WRITERS" "Haskell" "Electronic Music Digest" "NEW-LIST")))
  81. ;   
  82. ; By default, the entries in this list are matched exactly as 
  83. ; substrings of the given header fields.  If an entry begins with 
  84. ; the character ^ it will be matched as a regular expression.  If the 
  85. ; variable display-time-match-using-regexps is set, then all entries
  86. ; will be matched as regular expressions.
  87. ;
  88. ; Note that elements of display-time-my-addresses are NOT automatically
  89. ; included in display-time-junk-mail-checklist.  If you want mail from
  90. ; yourself to be considered junkmail, you must add your addresses to 
  91. ; display-time-junk-mail-checklist too.
  92. ;
  93. ;
  94. ; Xbiff Interface
  95. ; ---------------
  96. ;
  97. ; If you normally keep your emacs window iconified, reportmail can 
  98. ; maintain an xbiff or xbiff++ display as well.  The xbiff window will only
  99. ; be highlighted when non-junk mail is waiting to be read.  For example:
  100. ;
  101. ;    (if window-system-version
  102. ;        (setq display-time-use-xbiff t))
  103. ;    (setq display-time-xbiff-arg-list '("-update" "30" "-geometry" "+0+0"))
  104. ;    (setq display-time-xbiff-program "xbiff++")
  105. ;
  106. ; Other
  107. ; -----
  108. ;
  109. ; There are several other user-customization variables that you may wish
  110. ; to modify.  These are documented below.
  111.  
  112.  
  113. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  114. ;
  115. ; HISTORY
  116. ;
  117. ; 19 dec 93    Jamie Zawinski <jwz@lucid.com>
  118. ;    Protected it from edits of the *reportmail* buffer; made the process
  119. ;    filters not interfere with the match data.
  120. ;
  121. ; 15 dec 93    Jamie Zawinski <jwz@lucid.com>
  122. ;    Kyle renamed timer.el to itimer.el; made this use the new names.
  123. ;
  124. ; 27 aug 93    Jamie Zawinski <jwz@lucid.com>
  125. ;    Use mail-extr to parse addresses if it is loadable.
  126. ;
  127. ; 15 oct 92    Benjamin Pierce (bcp@cs.cmu.edu)
  128. ;    Merged recent changes
  129. ;
  130. ; 14 oct 92    Jamie Zawinski <jwz@lucid.com>
  131. ;    Added support for xbiff++.
  132. ;
  133. ; 17 sep 92    Benjamin Pierce (bcp@cs.cmu.edu)
  134. ;    Improvements to message display code.
  135. ;
  136. ; 15 sep 92    Benjamin Pierce (bcp@cs.cmu.edu)
  137. ;    Minor bug fixes.
  138. ;
  139. ; 1 may 92    Jamie Zawinski <jwz@lucid.com>
  140. ;    Converted to work with Kyle Jones' timer.el package.
  141. ;
  142. ; 3 may 91    Jamie Zawinski <jwz@lucid.com>
  143. ;    Made the display-time-sentinel make a fuss when the process dies.
  144. ;
  145. ; 26 mar 91    Jamie Zawinski <jwz@lucid.com>
  146. ;    Merged with BCP's latest posted version
  147. ;
  148. ;  5 mar 91    Jamie Zawinski <jwz@lucid.com>
  149. ;    Added compatibility with Emacs 18.57.
  150. ;
  151. ; 25 Jan 91    Benjamin Pierce (bcp@cs.cmu.edu)
  152. ;    Added facility for regular-expression matching of junk-mail
  153. ;    checklist.  Set inhibit-local-variables to t inside of 
  154. ;    display-time-process-new-mail to prevent letterbombs 
  155. ;    (suggested by jwz).
  156. ;
  157. ; 15 feb 91    Jamie Zawinski <jwz@lucid.com>
  158. ;    Made the values of display-time-message-separator and 
  159. ;    display-time-incoming-mail-file be initialized when this code
  160. ;    starts, instead of forcing the user to do it.  This means that
  161. ;    this code can safely be dumped with emacs.  Also, it now notices
  162. ;    when it's at CMU, and defaults to something reasonable.  Removed
  163. ;    display-time-wait-hard, because I learned how to make echo-area
  164. ;    messages be persistent (not go away at the first key).  I wish
  165. ;    GC messages didn't destroy it, though...
  166. ;
  167. ; 20 Dec 90    Jamie Zawinski <jwz@lucid.com>
  168. ;    Added new variables: display-time-no-file-means-no-mail, 
  169. ;    display-time-wait-hard, and display-time-junk-mail-ring-bell.
  170. ;    Made display-time-message-separator be compared case-insensitively.
  171. ;    Made the junk-mail checklist use a member-search rather than a 
  172. ;    prefix-search.
  173. ;
  174. ; 22 Jul 90    Benjamin Pierce (bcp@cs.cmu.edu)
  175. ;    Added support for debugging.
  176. ;
  177. ; 19 Jul 90    Benjamin Pierce (bcp@cs.cmu.edu)
  178. ;    Improved user documentation and eliminated known CMU dependencies.
  179. ;
  180. ; 13 Jul 90    Mark Leone (mleone@cs.cmu.edu)
  181. ;    Added display-time-use-xbiff option.  Various layout changes.
  182. ;
  183. ; 20 May 90    Benjamin Pierce (bcp@proof)
  184. ;    Fixed a bug that occasionally caused fields to be extracted
  185. ;    from the wrong buffer.
  186. ;
  187. ; 14 May 90    Benjamin Pierce (bcp@proof)
  188. ;    Added concept of junk mail and ability to display message
  189. ;    recipient in addition to sender and subject.  (Major internal
  190. ;    reorganization was needed to implement this cleanly.)
  191. ;
  192. ; 18 Nov 89    Benjamin Pierce (bcp@proof)
  193. ;    Fixed to work when display-time is called with 
  194. ;    global-mode-string not a list
  195. ;
  196. ; 15 Jan 89    David Plaut (dcp@k)
  197. ;    Added ability to discard load from displayed string
  198. ;
  199. ;    To use: (setq display-time-load nil)
  200. ;
  201. ;    Added facility for reporting incoming mail (modeled after gosmacs
  202. ;    reportmail.ml package written by Benjamin Pierce).
  203.  
  204. (require 'itimer)            ; this is xemacs, so why conditionalize?
  205. (require 'mail-extr)
  206.  
  207. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  208. ;;;                       User Variables                          ;;;
  209. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  210.  
  211. (defvar display-time-announce-mail t
  212.   "*Toggles whether name of mail sender is displayed in mode line.")
  213.  
  214. (defvar display-time-announce-junk-mail-too nil
  215.   "*When non-NIL, announce incoming junk mail as well as interesting mail")
  216.  
  217. (defvar display-time-time t
  218.   "*Toggles whether the time is displayed.")
  219.  
  220. (defvar display-time-load nil
  221.   "*Toggles whether machine load is displayed.")
  222.  
  223. (defvar display-time-day-and-date nil
  224.   "*Toggles whether day and date are displayed.")
  225.  
  226. (defvar display-time-mail-ring-bell nil
  227.   "*Toggles whether bell is rung on mail arrival.")
  228.  
  229. (defvar display-time-junk-mail-ring-bell nil
  230.   "*Toggles whether bell is rung on junk mail arrival.
  231. If display-time-mail-ring-bell is nil, this variable is ignored.")
  232.  
  233. (defvar display-time-my-addresses nil
  234.   "*Report the addressee of incoming mail in the message announcement, 
  235. unless it appears in this list  (See also display-time-match-using-regexps.)")
  236. ;; For example:
  237. ;; (setq display-time-my-addresses
  238. ;;  '("Benjamin.Pierce" "bcp" "Benjamin Pierce" "Benjamin C. Pierce"))
  239.  
  240. (defvar display-time-junk-mail-checklist nil
  241.   "*A list of lists of strings.  In each sublist, the first component is the
  242. name of a message field and the rest are values that flag a piece of
  243. junk mail.  If an entry begins with the character ^ it is matched as
  244. a regular expression rather than an exact prefix of the given header 
  245. field.  (See also display-time-match-using-regexps.)  
  246.  
  247. Note: elements of display-time-my-addresses are NOT automatically
  248.       included in display-time-junk-mail-checklist")
  249. ;; For example:
  250. ;; (setq display-time-junk-mail-checklist
  251. ;;  '(("From" "bcp" "Benjamin Pierce" "Benjamin.Pierce"
  252. ;;            "Mail Delivery Subsystem" "network" "daemon@bartok")
  253. ;;    ("To" "sml-request" "sml-redistribution-request" "computermusic" 
  254. ;;     "scheme" "TeXhax-Distribution-list")
  255. ;;    ("Resent-From" "Benjamin.Pierce")
  256. ;;    ("Sender" "WRITERS" "Haskell" "Electronic Music Digest" "NEW-LIST")))
  257.  
  258. (defvar display-time-match-using-regexps nil "*When non-nil, elements of 
  259. display-time-junk-mail-checklist and display-time-my-addresses are matched
  260. as regular expressions instead of literal prefixes of header fields.")
  261.  
  262. (defvar display-time-max-from-length 35
  263.   "*Truncate sender name to this length in mail announcements")
  264.  
  265. (defvar display-time-max-to-length 11
  266.   "*Truncate addressee name to this length in mail announcements")
  267.  
  268. (defvar display-time-interval 30
  269.   "*Seconds between updates of time in the mode line.  Also used
  270. as interval for checking incoming mail.")
  271.  
  272. (defvar display-time-no-file-means-no-mail t
  273.   "*Set this to T if you are on a system which deletes your mail-spool file 
  274. when there is no new mail.")
  275.  
  276. (defvar display-time-incoming-mail-file nil
  277.   "*User's incoming mail file.  Default is value of environment variable MAIL,
  278. if set;  otherwise /usr/spool/mail/$USER is used.")
  279.  
  280. (defvar display-time-message-separator nil)
  281.  
  282. (defvar display-time-flush-echo-area nil
  283.   "*If true, then display-time's echo-area message will be 
  284. automatically cleared when display-time-interval has expired.")
  285.  
  286. (defvar display-time-use-xbiff nil
  287.   "*If set, display-time uses xbiff to announce new mail.")
  288.  
  289. (defvar display-time-xbiff-program "xbiff") ; xbiff++ if you're cool
  290.  
  291. (defvar display-time-xbiff-arg-list nil
  292.   "*List of arguments passed to xbiff.  Useful for setting geometry, etc.")
  293. ;;; For example: 
  294. ;;; (setq display-time-xbiff-arg-list '("-update" "30" "-geometry" "+0+0"))
  295.  
  296. (defvar display-time-mail-arrived-file nil
  297.   "New mail announcements saved in this file if xbiff used.  Deleted when 
  298. mail is read.  Xbiff is used to monitor existence of this file.
  299. This file will contain the headers (and only the headers) of all of the
  300. messages in your inbox.  If you do not wish this to be readable by others, 
  301. you should name a file here which is in a protected directory.  Protecting
  302. the file itself is not sufficient, because the file gets deleted and
  303. recreated, and emacs does not make it easy to create protected files.")
  304.  
  305. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  306. ;;;                       Internal Variables                      ;;;
  307. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  308.  
  309. (defvar display-time-loadst-process nil
  310.   "The process providing time, load, and mail info.")
  311.  
  312. (defvar display-time-xbiff-process nil
  313.   "The xbiff process used to announce incoming mail.")
  314.  
  315. (defvar display-time-string nil
  316.   "Time displayed in mode line")
  317.  
  318. (defvar display-time-mail-buffer-name "*reportmail*"
  319.   "Name of buffer used for announcing mail.")
  320.  
  321. (defvar display-time-may-need-to-reset t
  322.   "Set to NIL when display-time-total-reset has not been called 
  323. since the last time we changed from having mail in the queue to an empty
  324. queue.")
  325.  
  326. (defvar display-time-debugging nil
  327.   "*When non-NIL, reportmail records various status information
  328. as it's working.")
  329.  
  330. (defvar display-time-debugging-delay nil 
  331.    "*When non-nil and display-time-debugging is set, sit for this 
  332. long after displaying each debugging message in mode line")
  333.  
  334. (defvar display-time-debugging-buffer "*Reportmail-Debugging*"
  335.   "Status messages are appended here.")
  336.   
  337. (defvar display-time-max-debug-info 20000
  338.   "Maximum size of debugging buffer")
  339.  
  340. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  341. ;;;                       Macros                                  ;;;
  342. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  343.  
  344. (defmacro display-time-del-file (filename)
  345.   (list 'if (list 'file-exists-p filename) (list 'delete-file filename)))
  346.  
  347. (defmacro display-time-debug (mesg &rest args)
  348.   (list
  349.      'if 'display-time-debugging
  350.          (list 'display-time-debug-mesg
  351.            (append (list 'format mesg) args))))
  352.  
  353. (defun display-time-init ()
  354.   ;; If the mail-file isn't set, figure it out.
  355.   (or display-time-incoming-mail-file
  356.       (setq display-time-incoming-mail-file
  357.         (or (getenv "MAIL")
  358.         (let ((user-name (user-login-name)))
  359.           (and user-name
  360.                (cond ((file-directory-p "/usr/spool/mail/") ; bsd
  361.                   (concat "/usr/spool/mail/" user-name))
  362.                  ((file-directory-p "/var/mail/") ; sysv
  363.                   (concat "/usr/spool/mail/" user-name)))))
  364.         "")))
  365.   ;; If the message-separator isn't set, set it to "From " unless
  366.   ;; the local hostname ends in ".CMU.EDU", where "^C" is used.
  367.   (or display-time-message-separator
  368.       (setq display-time-message-separator
  369.         (let ((case-fold-search t))
  370.           (if (string-match "\\.cmu\\.edu" (system-name))
  371.           "\^C"
  372.           "From "))))
  373.   ;; if this isn't set, these are probably right...
  374.   (or display-time-my-addresses
  375.       (setq display-time-my-addresses
  376.         (list (user-full-name) (user-login-name))))
  377.   ;;
  378.   (or display-time-mail-arrived-file
  379.       (setq display-time-mail-arrived-file
  380.         (expand-file-name ".mail-arrived" (getenv "HOME"))))
  381.   )
  382.  
  383. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  384. ;;;                       Time Display                            ;;;
  385. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  386.  
  387. (defun display-time-kill ()
  388.   "Kill all display-time processes.  Done automatically if display-time
  389. is re-invoked."
  390.   (interactive)
  391.   (display-time-debug "display-time-kill")
  392.   (if display-time-loadst-process (delete-process display-time-loadst-process))
  393.   (if display-time-xbiff-process (delete-process display-time-xbiff-process))
  394. )
  395.  
  396. (defun display-time ()
  397.   "Displays current time, date, load level, and incoming mail status in 
  398. mode line of each buffer (if corresponding user variables are set)."
  399.   (interactive)
  400.   (display-time-debug "display-time")
  401.   (display-time-init)
  402.   (let ((process-connection-type nil))    ; UIUCDCS mod
  403.     (save-excursion
  404.       (display-time-kill)
  405.       (if (or (string-equal "" display-time-incoming-mail-file)
  406.           (and (not display-time-no-file-means-no-mail)
  407.            (not (file-exists-p display-time-incoming-mail-file))))
  408.       (progn 
  409.          (message "Reportmail: mail spool file \"%s\" not found" 
  410.               display-time-incoming-mail-file)
  411.          (sit-for 1)
  412.          (beep)))
  413.       (if (not global-mode-string) (setq global-mode-string '("")))
  414.       (if (not (listp global-mode-string))
  415.       (setq global-mode-string (list global-mode-string "  ")))
  416.       (if (not (memq 'display-time-string global-mode-string))
  417.       (setq global-mode-string
  418.         (append global-mode-string '(display-time-string))))
  419.       (setq display-time-string "time and load")
  420.       
  421.       (let ((old (get-itimer "display-time")))
  422.     (if old (delete-itimer old))
  423.     (start-itimer "display-time" 'display-time-timer-function
  424.               display-time-interval display-time-interval)
  425.     (display-time-timer-function))
  426.  
  427.       (if display-time-use-xbiff
  428.       (progn
  429.         (display-time-del-file display-time-mail-arrived-file)
  430.         (setq display-time-xbiff-process
  431.           (apply 'start-process "display-time-xbiff" nil
  432.              display-time-xbiff-program
  433.              "-file" display-time-mail-arrived-file
  434.              display-time-xbiff-arg-list))
  435.         (process-kill-without-query display-time-xbiff-process)
  436.         (sit-for 1)            ; Need time to see if xbiff fails.
  437.         (if (/= 0 (process-exit-status display-time-xbiff-process))
  438.         (error "Display time: xbiff failed.  Check xbiff-arg-list"))))))
  439.   (display-time-total-reset))
  440.  
  441. (defun display-time-timer-function ()
  442.   ;; was: (defun display-time-filter-18-57 (proc string) ; args are ignored
  443.   ;; but we're not supporting version 18 here and I'm trimming excess
  444.   (save-match-data
  445.     (display-time-debug "display-time-timer-function")
  446.     (if display-time-flush-echo-area
  447.     (progn
  448.       (display-time-debug "flush echo area")
  449.       (display-time-message "")))
  450.     (let ((mailp (and (file-exists-p display-time-incoming-mail-file)
  451.               (not (eq 0 (nth 7 (file-attributes
  452.                      display-time-incoming-mail-file)))))))
  453.       (if display-time-announce-mail
  454.       (if mailp
  455.           (display-time-process-new-mail)
  456.         (display-time-total-reset)))
  457.       ;; Format the mode line time display
  458.       (let ((time-string (if mailp
  459.                  (if display-time-announce-mail
  460.                  display-time-mail-modeline
  461.                    "Mail "))))
  462.     (if display-time-time
  463.         (let* ((time (current-time-string))
  464.            (hour (read (substring time 11 13)))
  465.            (pm (>= hour 12)))
  466.           (if (> hour 12) (setq hour (- hour 12)))
  467.           (if (= hour 0) (setq hour 12))
  468.           (setq time-string
  469.             (concat time-string
  470.                 (format "%d" hour) (substring time 13 16)
  471.                 (if pm "pm " "am ")))))
  472.     (if display-time-day-and-date
  473.         (setq time-string
  474.           (concat time-string
  475.               (substring (current-time-string) 0 11))))
  476.     (if display-time-load
  477.         (setq time-string
  478.           (concat time-string
  479.               (condition-case ()
  480.                   (let* ((la (car (load-average)))
  481.                      (load (if (zerop la)
  482.                            nil
  483.                          (format "%03d" la))))
  484.                 (if load
  485.                     (concat (substring load 0 -2)
  486.                         "." (substring load -2))
  487.                   ""))
  488.                 (error "load-error"))
  489.               " ")))
  490.     ;; Install the new time for display.
  491.     (setq display-time-string time-string)
  492.     (force-mode-line-update t)))))
  493.  
  494. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  495. ;;;                       Mail processing                         ;;;
  496. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  497.  
  498. (defvar display-time-mail-who-from ""
  499.   "Short-form name of sender of last piece of interesting unread mail")
  500.  
  501. (defvar display-time-mail-modeline ""
  502.   "Terse mail announcement (displayed in modeline)")
  503.  
  504. (defvar display-time-previous-mail-buffer-max 1
  505.   "The length of the mail buffer the last time we looked at it")
  506.  
  507. (defvar display-time-msg-count 0
  508.   "How many interesting messages have arrived")
  509.  
  510. (defvar display-time-junk-msg-count 0
  511.   "How many junk messages have arrived")
  512.  
  513. (defvar display-time-last-message nil) ; enormous hack
  514.  
  515.  
  516. ;; A test procedure for trying out new display-time features
  517. ;(defun display-time-test ()
  518. ;  (interactive)
  519. ;  (display-time-reset-mail-processing)
  520. ;  (display-time-process-new-mail))
  521.  
  522. (defun display-time-manual-reset ()
  523.   "Utility function to be called externally to make reportmail notice
  524. that things may have changed."
  525.   (display-time-debug "Manual reset")
  526.   (display-time-timer-function))
  527.  
  528. (defun display-time-total-reset ()
  529.   (display-time-debug "display-time-total-reset")
  530.   (if display-time-may-need-to-reset
  531.    (progn
  532.     (setq display-time-may-need-to-reset nil)
  533.     (display-time-debug "Resetting mail processing")
  534.     (let ((mail-buffer (get-buffer display-time-mail-buffer-name)))
  535.       (cond (mail-buffer
  536.          ;; unmodify it before killing it in case it has accidentally
  537.          ;; been typed in to.
  538.          (save-excursion
  539.            (set-buffer mail-buffer)
  540.            (set-buffer-modified-p nil))
  541.          (kill-buffer mail-buffer))))
  542.     (if display-time-use-xbiff
  543.     ;; This function is only called when no mail is in the spool.
  544.     ;; Hence we should delete the mail-arrived file.
  545.     (display-time-del-file display-time-mail-arrived-file))
  546.     (display-time-reset)
  547.     )))
  548.  
  549. (defun display-time-reset ()
  550.   (display-time-debug "display-time-reset")
  551.   (setq display-time-msg-count 0)
  552.   (setq display-time-junk-msg-count 0)
  553.   (setq display-time-mail-who-from "Junk mail")
  554.   (setq display-time-mail-modeline "")
  555.   (setq display-time-previous-mail-buffer-max 1)
  556.   (display-time-message "") ; clear the echo-area.
  557.   )
  558.  
  559. (defun display-time-process-new-mail ()
  560.   (setq display-time-may-need-to-reset t)
  561.   (let ((mail-buffer (get-buffer display-time-mail-buffer-name))
  562.     (inhibit-local-variables t)
  563.     (enable-local-variables nil))
  564.     (if (not (and mail-buffer (verify-visited-file-modtime mail-buffer)))
  565.       (save-window-excursion
  566.        (save-excursion
  567.     (display-time-debug "Spool file has changed... rereading...")
  568.     (cond (mail-buffer
  569.            ;; unmodify it before killing it in case it has accidentally
  570.            ;; been typed in to.
  571.            (save-excursion
  572.          (set-buffer mail-buffer)
  573.          (set-buffer-modified-p nil))
  574.            (kill-buffer mail-buffer))))
  575.     ;; Change to pop-to-buffer when we're debugging:
  576.     (set-buffer (get-buffer-create display-time-mail-buffer-name))
  577.     (buffer-disable-undo (current-buffer))
  578.     (erase-buffer)
  579.     (condition-case nil
  580.         ;; I wish we didn't have to mark the buffer as visiting the file,
  581.         ;; since that interferes with the user's ability to use find-file
  582.         ;; on their spool file, but there's no way to simulate what
  583.         ;; verify-visited-file-modtime does.  Lose lose.
  584.         (let ((buffer-read-only nil))
  585.           (insert-file-contents display-time-incoming-mail-file t))
  586.       (file-error nil))
  587.     ;; this buffer belongs to us; hands off.
  588.     (setq buffer-read-only t)
  589.     (display-time-process-mail-buffer)))))
  590.  
  591. (defun display-time-process-mail-buffer ()
  592.   (if (< display-time-previous-mail-buffer-max (point-max))
  593.       (let ((case-fold-search nil))
  594.     (goto-char display-time-previous-mail-buffer-max)
  595.     (if (not (looking-at
  596.           (regexp-quote display-time-message-separator)))
  597.         (display-time-reset)))
  598.     (display-time-reset))
  599.   (goto-char display-time-previous-mail-buffer-max)
  600.   (if display-time-use-xbiff
  601.       (save-excursion
  602.     (set-buffer (get-buffer-create " *reportmail-tmp*"))
  603.     (erase-buffer)))
  604.   (let ((case-fold-search nil)
  605.     (start (point))
  606.     end junkp ring-bell)
  607.     (while (not (eobp))
  608.       (if (search-forward (concat "\n" display-time-message-separator)
  609.               nil 'end)
  610.       (setq end (1+ (match-beginning 0)))
  611.     (setq end (point-max)))
  612.       (narrow-to-region start end)
  613.       (setq junkp (display-time-process-this-message))
  614.       (if (and display-time-mail-ring-bell (not ring-bell))
  615.       (setq ring-bell (if junkp display-time-junk-mail-ring-bell t)))
  616.       (widen)
  617.       (goto-char (if (= end (point-max)) (point-max) (1+ end)))
  618.       (setq start end))
  619.  
  620.     (if ring-bell
  621.     (if (string-match "XEmacs" emacs-version)
  622.         (beep nil 'reportmail)
  623.       (beep))))
  624.   
  625.   (if display-time-use-xbiff
  626.       (save-excursion
  627.     (set-buffer (get-buffer-create " *reportmail-tmp*"))
  628.     (if (zerop (buffer-size))
  629.         nil
  630.       (write-region (point-min) (point-max)
  631.             display-time-mail-arrived-file
  632.             t 'nomsg)
  633.       (erase-buffer)
  634. ;      ;; there's no way to get append-to-file to not dump the message
  635. ;      ;; "Wrote file ..." in the echo area, so re-write the last message
  636. ;      ;; we intended to write.
  637. ;      (if display-time-last-message
  638. ;          (display-time-message "%s" display-time-last-message))
  639.       )))
  640.   
  641.   (setq display-time-previous-mail-buffer-max (point-max)))
  642.  
  643. (defun display-time-process-this-message ()
  644.   (display-time-debug "display-time-process-this-message")
  645.   (let ((junk-p (display-time-junk-message)))
  646.     (if junk-p
  647.     (display-time-process-junk-message)
  648.       (display-time-process-good-message))
  649.     ;; Update mode line contents
  650.     (setq display-time-mail-modeline 
  651.       (concat "[" (display-time-format-msg-count) 
  652.           display-time-mail-who-from
  653.           "] "))
  654.     (display-time-debug "New mode line: %s " display-time-mail-modeline)
  655.     junk-p))
  656.  
  657. (defun display-time-junk-message ()
  658.   "Check to see whether this message is interesting"
  659.  
  660.   (display-time-debug "Comparing current message to junk mail checklist")
  661.  
  662.   (let ((checklist display-time-junk-mail-checklist)
  663.     (junk nil))
  664.     (while (and checklist (not junk))
  665.       (if (display-time-member 
  666.        (display-time-get-field (car (car checklist)))
  667.        (cdr (car checklist)))
  668.       (setq junk t)
  669.       (setq checklist (cdr checklist))))
  670.     junk))
  671.  
  672. (defun display-time-message (&rest message-args)
  673.   (let ((str (apply 'format message-args))
  674.     (in-echo-area-already (eq (selected-window) (minibuffer-window))))
  675.     (setq display-time-last-message str)
  676.     ;; don't stomp the echo-area-buffer if reading from the minibuffer now.
  677.     (display-time-debug "display-time-message (%s)" str)
  678.     (if (not in-echo-area-already)
  679.     (save-excursion
  680.       (save-window-excursion
  681.         (display-time-debug "Overwriting echo area with message")
  682.         (select-window (minibuffer-window))
  683.         (delete-region (point-min) (point-max))
  684.         (insert str))))
  685.     ;; if we're reading from the echo-area, and all we were going to do is
  686.     ;; clear the thing, like, don't bother, that's annoying.
  687.     (if (and in-echo-area-already (string= "" str))
  688.     nil
  689.       (if (and (string= str "") (string-match "^19" emacs-version))
  690.       (message nil)
  691.     (message "%s" str)))))
  692.  
  693. (defun display-time-process-good-message ()
  694.   (display-time-debug "Formatting message announcement (good message)")
  695.  
  696.   ;; Update the message counter
  697.   (setq display-time-msg-count (+ display-time-msg-count 1))
  698.  
  699.   ;; Format components of announcement
  700.   (let* ((subject (display-time-get-field "Subject" ""))
  701.      (from (display-time-get-field "From" ""))
  702.      (to (display-time-get-field "To" ""))
  703.      (print-subject (if (string= subject "")
  704.                 ""
  705.                 (concat " (" subject ")")))
  706.      (print-from (display-time-truncate from display-time-max-from-length))
  707.      (short-from (display-time-truncate 
  708.               (display-time-extract-short-addr from) 25))
  709.      (print-to (if (display-time-member to display-time-my-addresses)
  710.                ""
  711.                (display-time-truncate 
  712.             (display-time-extract-short-addr to)
  713.             display-time-max-to-length))))
  714.  
  715.     ;; Announce message
  716.     (let ((msg (concat 
  717.            (display-time-format-msg-count)
  718.            "Mail " 
  719.            (if (string= print-to "") "" 
  720.                (concat "to " print-to " "))
  721.            "from " print-from 
  722.            print-subject)))
  723.       (if display-time-use-xbiff
  724.       (save-excursion
  725.         (let* ((tmp-buf (get-buffer-create " *reportmail-tmp*"))
  726.            (buf (current-buffer))
  727.            (start (point-min))
  728.            (end (save-excursion
  729.               (goto-char start)
  730.               (search-forward "\n\n" nil 0)
  731.               (point))))
  732.           (set-buffer tmp-buf)
  733.           (goto-char (point-max))
  734.           (insert-buffer-substring buf start end)
  735.           (insert "\n\n")
  736.           )))
  737.       (display-time-debug "Message: %s" msg)
  738.       (display-time-message "%s" msg))
  739.     ;; Update mode line information
  740.     (setq display-time-mail-who-from short-from)))
  741.  
  742. (defun display-time-process-junk-message ()
  743.   (display-time-debug "Formatting message announcement (junk message)")
  744.  
  745.   ;; Update the message counter
  746.   (setq display-time-junk-msg-count (+ display-time-junk-msg-count 1))
  747.  
  748.   ;; Format components of announcement
  749.   (let* ((subject (display-time-get-field "Subject" ""))
  750.      (from (display-time-get-field "From" ""))
  751.      (to (display-time-get-field "To" ""))
  752.      (print-subject (if (string= subject "")
  753.                 ""
  754.                 (concat " (" subject ")")))
  755.      (print-from (display-time-truncate from display-time-max-from-length))
  756.      (print-to (if (display-time-member to display-time-my-addresses)
  757.                ""
  758.                (display-time-truncate 
  759.             (display-time-extract-short-addr to)
  760.             display-time-max-to-length))))
  761.  
  762.     ;; Announce message
  763.     (if display-time-announce-junk-mail-too
  764.       (let ((msg (concat 
  765.               (display-time-format-msg-count)
  766.               "Junk Mail " 
  767.               (if (string= print-to "") "" 
  768.             (concat "to " print-to " "))
  769.               "from " print-from 
  770.               print-subject)))
  771.         (display-time-message "%s" msg)
  772.         (display-time-debug "Message: %s" msg)))))
  773.  
  774. (defun display-time-format-msg-count ()
  775.    (if (> (+ display-time-msg-count display-time-junk-msg-count) 1) 
  776.        (concat 
  777.     (int-to-string display-time-msg-count) 
  778.     (if (> display-time-junk-msg-count 0)
  779.         (concat "(" (int-to-string display-time-junk-msg-count) ")"))
  780.     ": ")
  781.        ""))
  782.  
  783. (defun display-time-get-field (field &optional default)
  784.   (cond ((not (equal (buffer-name) display-time-mail-buffer-name))
  785.     (beep)
  786.     (message "reportmail bug: processing buffer %s, not %s"
  787.          (buffer-name)
  788.          display-time-mail-buffer-name)
  789.     (sit-for 2)))
  790.   (goto-char (point-min))
  791.   (let* ((case-fold-search t)
  792.      (result
  793.      (if (re-search-forward (concat "^" field ":[ |\C-i]*") nil t)
  794.          (let ((start (point)))
  795.            (end-of-line)
  796.            (while (looking-at "\n[ \t]")
  797.          (forward-line 1)
  798.          (end-of-line))
  799.            (buffer-substring start (point)))
  800.          (or default "<unknown>"))))
  801.     (display-time-debug "value of %s field is %s" field result)
  802.     result))
  803.  
  804. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  805. ;;;                       Auxilliary Functions                    ;;;
  806. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  807.  
  808. (defun display-time-member (e l)
  809.   "Is string E matched by an element of list L?
  810. When an element of L begins with ^, match it as a regexp.  Otherwise,
  811. ignore case and match exactly.  If display-time-match-using-regexps is
  812. non-nil, always match using regexps."
  813.   (let ((done nil)
  814.     (result nil))
  815.     (while (not done)
  816.       (cond 
  817.        ((null l) (setq done t))
  818.        ((or display-time-match-using-regexps (= (elt (car l) 0) ?^))
  819.     (if (string-match (car l) e)
  820.         (setq result l done t)
  821.       (setq l (cdr l))))
  822.        ((string-match (regexp-quote (downcase (car l))) (downcase e)) 
  823.     (setq result l done t))
  824.        (t 
  825.     (setq l (cdr l)))))
  826.     result))
  827.  
  828. (defun display-time-truncate (s max)
  829.   (if (and s (>= (length s) max))
  830.       (concat (substring s 0 max) "\\")
  831.       s))
  832.  
  833. (defun display-time-extract-short-addr (long-addr)
  834.   (let ((result (and (fboundp 'mail-extract-address-components)
  835.              (mail-extract-address-components long-addr))))
  836.     (or (nth 0 result)  ; hairily extracted real name
  837.     (let ((name "\\([A-Za-z0-9-_+\\. ]+\\)"))
  838.       (setq long-addr (or (nth 2 result) long-addr))
  839.       (if (or 
  840.            ;; David Plaut <dcp@CS.CMU.EDU>     -> David Plaut
  841.            ;; (doesn't happen if mail-extr loaded)
  842.            (string-match (concat name "[ |    ]+<.+>") long-addr)
  843.     
  844.            ;; anything (David Plaut) anything     -> David Plaut
  845.            ;; (doesn't happen if mail-extr loaded)
  846.            (string-match ".+(\\(.+\\)).*" long-addr)
  847.      
  848.            ;; plaut%address.bitnet@vma.cc.cmu.edu -> plaut
  849.            (string-match (concat name "%.+@.+") long-addr)
  850.  
  851.            ;; random!uucp!addresses!dcp@uu.relay.net -> dcp
  852.            (string-match (concat ".*!" name "@.+") long-addr)
  853.  
  854.            ;; David.Plaut@CS.CMU.EDU         -> David.Plaut
  855.            (string-match (concat name "@.+") long-addr)
  856.            )
  857.           (substring long-addr (match-beginning 1) (match-end 1))
  858.         long-addr)))))
  859.  
  860. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  861. ;;;                       Debugging Support                       ;;;
  862. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  863.  
  864. (defvar display-time-debugging-messages nil
  865.   "When non-NIL, reportmail displays status messages in real time.")
  866.  
  867. (defun display-time-debug-mesg (mesg)
  868.  (save-match-data
  869.   (if display-time-debugging-messages
  870.       (progn 
  871.     (message "Reportmail: %s" mesg)
  872.     (sit-for 1)
  873.     ))
  874.   (save-excursion
  875.     (save-window-excursion
  876.       (set-buffer (get-buffer-create display-time-debugging-buffer))
  877.       (goto-char (point-max))
  878.       (insert (substring (current-time-string) 11 16) "  " mesg "\n")
  879.       ;; Make sure the debugging buffer doesn't get out of hand
  880.       (if (> (point-max) display-time-max-debug-info)
  881.       (delete-region (point-min) 
  882.              (- (point-max) display-time-max-debug-info)))))
  883.   (if display-time-debugging-delay
  884.       (progn (message "Reportmail: %s" mesg)
  885.          (sit-for display-time-debugging-delay)))))
  886.  
  887. (provide 'reportmail)
  888.